home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Light ROM 1
/
LIGHT-ROM 1 (Amiga Library Services)(1994).iso
/
ffdisks
/
d925.lha
/
DonsGenies
/
DonsGenies.lha
/
Don'sGenies
/
MakeBarChart_Vert.pprx
< prev
next >
Wrap
Text File
|
1992-07-16
|
4KB
|
170 lines
/*@BMakeBarChart_Vert @P@ICopyright Michael S. Fahrion. Jan., 1992
Makes a simple vertical bar chart from data entered by the user.
(This version debugged/enhanced by Don Cox).
*/
numeric digits 8
cr = '0a'x
call SafeEndEdit.rexx()
call ppm_AutoUpdate(0)
call ppm_NewGroup()
units = ppm_GetUnits()
call ppm_SetUnits(1)
signal on halt
signal on break_c
signal on break_e
signal on break_d
box = ppm_ClickOnBox("Click on box to make chart..")
if box = 0 then
do
call ppm_Inform(1, "No box selected",)
call ppm_ClearStatus()
exit
end
/* extract box attributes */
boxsize = ppm_GetBoxSize(box)
boxpos = ppm_GetBoxPosition(box)
if ppm_Inform(2, "Delete box?",) = 1 then call ppm_DeleteBox(box)
boxwidth = word(boxsize, 1)
boxheight = word(boxsize, 2)
boxleft = word(boxpos, 1)
boxtop = word(boxpos, 2)
/*trace(results)*/
nmbars = GetUserText(4, "Number of Bars")
if nmbars > 12 then exit_msg("Max number of bars is 12")
form = ' Bar 1'
do x = 2 while x <= nmbars
form = form cr 'Bar' x
end
form = form cr 'Top scale #'
form = ppm_GetForm("Chart Data",6,form)
if form = "" then exit_msg("Operation Cancelled")
x = 1
do forever
parse var form bdata.x '0a'x form
if bdata.x = "" then leave
x = x + 1
end
tchart = nmbars + 1
topchart = bdata.tchart
form = ' Bar label 1'
do x = 2 while x <= nmbars
form = form cr 'Bar label' x
end
form = ppm_GetForm("Chart Label",8,form)
if form = "" then exit_msg("Operation Cancelled")
x = 1
do forever
parse var form blabel.x '0a'x form
if bdata.x = "" then leave
x = x + 1
end
facelist = ppm_GetTypeFaceList()
facelist = substr(facelist, pos('0a'x, facelist) +1) /*strip off the number*/
face = ppm_SelectFromList("Select Typeface",32,18,0,facelist)
/* Draw background chart and grid lines */
barbottom = boxtop + boxheight
call ppm_ShowStatus("Creating Chart Grid")
linespace = boxheight / 10
yline = linespace + boxtop
call ppm_SetLineWeight(.5)
do 9
call ppm_DrawLine(boxleft, yline, boxleft + boxwidth, yline)
yline = yline + linespace
call ppm_AddToGroup()
end
call ppm_SetLineWeight(1)
call ppm_SetFillPattern(0)
call ppm_DrawRect(boxleft, boxtop, boxleft + boxwidth, boxtop + boxheight)
call ppm_AddToGroup()
call ppm_MergeGroup()
/* add chart numbers */
call ppm_SetFont(face)
call ppm_SetSize(10)
call ppm_SetStyle(N)
call ppm_SetJustification(1)
bleft = boxleft - .55
btop = boxtop - .01
ctext = topchart
ctextadjust = topchart / 10
i = 1
do 11
cbox = ppm_CreateBox(bleft, btop, .5, .25, 0)
btop = btop + linespace
call ppm_TextIntoBox(cbox, ctext)
ctext = topchart - (ctextadjust * i)
i = i + 1
end
/* Draw chart bars and put on labels */
barcalc = boxheight / topchart
barspace = (nmbars + 1) * .125
barwidth = (boxwidth - barspace) / nmbars
barpos = boxleft + .125
call ppm_SetFillPattern(5)
call ppm_SetJustification(2)
call ppm_SetLineSpacing(2,100)
i = 1
do nmbars
call ppm_ShowStatus("Working on bar:" i)
barheight = bdata.i * barcalc
bartop = barbottom - barheight
call ppm_DrawRect(barpos, bartop, barpos + barwidth, barbottom)
cbox = ppm_CreateBox(barpos, barbottom + .03, barwidth, .4, 0)
call ppm_TextIntoBox(cbox, upper(blabel.i))
cbox = ppm_CreateBox(barpos, bartop - .2, barwidth, .15, 0)
call ppm_SetBoxTransparent(cbox, 0)
call ppm_TextIntoBox(cbox, bdata.i)
barpos = barpos + barwidth + .125
i = i + 1
end
exit_msg("Done")
break_d:
break_e:
break_c:
halt:
call exit_msg("User aborted Genie!")
exit_msg: procedure expose units
do
parse arg message
call ppm_ClearStatus()
if message ~= '' then
call ppm_Inform(1, message,)
call ppm_SetUnits(units)
call ppm_ClearStatus()
call ppm_AutoUpdate(1)
exit
end